home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
printr3.arc
/
PRINTR2.PRT
< prev
next >
Wrap
Text File
|
1991-04-28
|
46KB
|
904 lines
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 1
Line : D Statement
1 : 0
2 : 0 {$S-,V-}
3 : 0 (****************************************************************************)
4 : 0 (* *)
5 : 0 (* Mesa Software *)
6 : 0 (* 3302 Fourth Ave, Suite 101 *)
7 : 0 (* San Diego, Ca. 92103 *)
8 : 0 (* *)
9 : 0 (* *)
10 : 0 (* Program : Unit Printr2 File Name : printr2.pas *)
11 : 0 (* *)
12 : 0 (* Release : Version 1.0 Date : Dec. 15, 1989 *)
13 : 0 (* *)
14 : 0 (* *)
15 : 0 (****************************************************************************)
16 : 0
17 : 0 Unit printr2;
18 : 0 Interface
19 : 0
20 : 0 {Requires TJocks5.
21 : 0 Use at your own risk. Mesa Software assumes no
22 : 0 liability for the use of this software}
23 : 0
24 : 0 uses CRT,dos,fastttt5,miscttt5,winttt5,strnttt5,keyttt5;
25 : 0
26 : 0 G-1CONST-0H
27 : 0 esc = #27;
28 : 0 off = #0;
29 : 0 NLQ = (esc + '!' + #1);
30 : 0 NLQ_OFF = (esc + '!' + #0);
31 : 0 Supercrpt = (esc + 'S' + #0);
32 : 0 Subscrpt = (esc + 'S' + #1);
33 : 0 scrp_off = (esc + 'T');
34 : 0 Comprsd = (esc + #15);
35 : 0 uncomprsd = (esc + #18);
36 : 0 Emphaszd = (esc + 'E');
37 : 0 unemphszd = (esc + 'F');
38 : 0 Dbl_prtng = (esc + 'G');
39 : 0 un_dbl = (esc + 'H');
40 : 0
41 : 0 dbl_wid = (esc + 'W' + #1);
42 : 0 un_wid = (esc + 'W' + off);
43 : 0
44 : 0 {The two print commands below are the same as the two
45 : 0 above.}
46 : 0 expanded = esc + '!' + #48;
47 : 0 unexpand = esc + 'W' + off;
48 : 0
49 : 0
50 : 0 undr_lin = (esc + '-' + #1);
51 : 0 undr_lin_off = (esc + '-' + off);
52 : 0 backspc = (#8);
53 : 0 char_byte = '$';
54 : 0 {This is the char you see in the banner and
55 : 0 report headers. Try !,*,#, or %. Taylor
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 2
Line : D Statement
56 : 0 your chars for different reports}
57 : 0
58 : 0 thirteen = 13;
59 : 0 backspace = #8;
60 : 0 centered = #27 + 'a' + #1;
61 : 0 left_margin = #27 + 'a' + off;
62 : 0 line_feed = #10;
63 : 0 form_feed = #12;
64 : 0 carig_rtn = #13;
65 : 0 author = 'Tom Devanney';
66 : 0
67 : 0 G-1TYPE-0H
68 : 0 Datestr = G-1STRING-0H[8];
69 : 0
70 : 0 G-1VAR-0H
71 : 0 G-1LST-0H : G-1TEXT-0H;
72 : 0 page : G-1STRING-0H;
73 : 0 num : G-1INTEGER-0H;
74 : 0
75 : 0 G-1FUNCTION-0H Printer_on : G-1BOOLEAN-0H;
76 : 0 G-1PROCEDURE-0H Beepr;
77 : 0 G-1PROCEDURE-0H banner(co_nam,addrs,city,st,zip,phone,rpt_title : G-1STRING-0H);
78 : 0 G-1PROCEDURE-0H Report_hdr(Rpt_Title,co_nam,addrs,city,st,zip,page : G-1STRING-0H);
79 : 0 G-1FUNCTION-0H IO_Not_OK(num : word) : G-1BOOLEAN-0H;
80 : 0 G-1FUNCTION-0H GetSystemDate : Datestr;
81 : 0 G-1FUNCTION-0H NumToStr(number : LongInt) : G-1STRING-0H;
82 : 0 G-1PROCEDURE-0H Check_color(G-1VAR-0H Textf,G-1BACK-0H : G-1BYTE-0H);
83 : 0
84 : 0 {======================================================================}
85 : 0
86 : 0 Implementation
87 : 0
88 : 0 {======================================================================}
89 : 0
90 : 0
91 : 0 G-1PROCEDURE-0H Check_color(G-1VAR-0H Textf,G-1BACK-0H : G-1BYTE-0H);
92 : 0
93 : 0 {This is to change any color combo into white on black for monochrome
94 : 0 screens}
95 : 0
96 : 1 G-1BEGIN-0H
97 : 1 | G-1IF-0H (baseOfScreen <> $B800) G-1THEN-0H
98 : 2 | G-1BEGIN-0H
99 : 2 | | Textf := 15;
100 : 2 | | G-1BACK-0H := 0;
101 : 1 | G-1END-0H;
102 : 0 G-1END-0H;
103 : 0
104 : 0 G-1FUNCTION-0H GetSystemDate : Datestr; {string[10]}
105 : 0
106 : 0 {This is to get a system date from the system and return as a string}
107 : 0
108 : 0 G-1VAR-0H
109 : 0 regs : Registers;
110 : 0 st2,st3,st4 : G-1STRING-0H[10];
111 : 0
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 3
Line : D Statement
112 : 1 G-1BEGIN-0H
113 : 1 | G-1FILLCHAR-0H(regs,G-1SIZEOF-0H(regs),0);
114 : 1 | Regs.AH := $2A; {Interrupt for system date}
115 : 1 | G-1MSDOS-0H(regs);
116 : 1 | G-1WITH-0H regs G-1DO-0H
117 : 2 | G-1BEGIN-0H
118 : 2 | | G-1STR-0H(CX, st2); {year}
119 : 2 | | G-1STR-0H(DH, st3); {Month}
120 : 2 | | G-1STR-0H(DL, st4); {Day}
121 : 1 | G-1END-0H;
122 : 1 | G-1IF-0H G-1LENGTH-0H(st3) = 1 G-1THEN-0H st3 := '0' + st3;
123 : 1 | G-1IF-0H G-1LENGTH-0H(st4) = 1 G-1THEN-0H st4 := '0' + st4;
124 : 1 | getsystemdate := st3 + '/' + st4 + '/' + G-1COPY-0H(st2,3,2);
125 : 0 G-1END-0H;
126 : 0
127 : 0
128 : 0 G-1FUNCTION-0H NumToStr(number : LongInt) : G-1STRING-0H;
129 : 0
130 : 0 {-Convert a longinteger,word,integer,byte to a string}
131 : 0
132 : 0 G-1VAR-0H
133 : 0 numstr : G-1STRING-0H;
134 : 1 G-1BEGIN-0H
135 : 1 | G-1STR-0H(number,numstr);
136 : 1 | NumToStr := numstr;
137 : 0 G-1END-0H;
138 : 0
139 : 0
140 : 0 G-1PROCEDURE-0H Beepr;
141 : 0
142 : 0 {This is a fancy lawyer telephone beeper sound
143 : 0 The sound you hear is money}
144 : 0
145 : 0 G-1CONST-0H
146 : 0 itration = 3;
147 : 0 G-1VAR-0H
148 : 0 countr : G-1INTEGER-0H;
149 : 0
150 : 1 G-1BEGIN-0H
151 : 1 | G-1FOR-0H countr := 1 G-1TO-0H itration G-1DO-0H
152 : 2 | G-1BEGIN-0H
153 : 2 | | G-1SOUND-0H(949); {925..999}
154 : 2 | | G-1DELAY-0H(50);
155 : 2 | | G-1SOUND-0H(499); {450..600}
156 : 2 | | G-1DELAY-0H(50);
157 : 1 | G-1END-0H;
158 : 1 | G-1NOSOUND-0H;
159 : 0 G-1END-0H; { Beep }
160 : 0
161 : 0 G-1FUNCTION-0H Printer_on : G-1BOOLEAN-0H;
162 : 0
163 : 0 {This is a printer screen that is easy to use}
164 : 0
165 : 0 G-1VAR-0H
166 : 0 line,col,end_lin,
167 : 0 end_col,box_knd : G-1INTEGER-0H;
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 4
Line : D Statement
168 : 0 Regs : registers;
169 : 0 answr : G-1CHAR-0H;
170 : 0 message : G-1STRING-0H;
171 : 0 textf,boxf,G-1BACK-0H : G-1BYTE-0H;
172 : 0
173 : 1 G-1BEGIN-0H
174 : 1 | answr := ' ';
175 : 1 | G-1CLRSCR-0H;
176 : 1 | col := 10;
177 : 1 | line := 10;
178 : 1 | end_col := 70;
179 : 1 | end_lin := 20;
180 : 1 | box_knd := 0; {0..4,5..9 choose another box type to suit your style}
181 : 1 | Printer_on := G-1FALSE-0H;
182 : 1 | savescreen(1);
183 : 1 | boxf := white;
184 : 1 | G-1BACK-0H := lightgray;
185 : 1 | check_color(boxf,G-1BACK-0H);
186 : 1 | Fbox(col,line,end_col,end_lin,boxf,G-1BACK-0H,box_knd);
187 : 1 | boxf := yellow;
188 : 1 | G-1BACK-0H := red;
189 : 1 | check_color(boxf,G-1BACK-0H);
190 : 1 | Fbox(col + 1 ,line + 1,end_col - 1,end_lin - 1,boxf,G-1BACK-0H,box_knd);
191 : 1 | G-1BACK-0H := black;
192 : 1 | check_color(boxf,G-1BACK-0H);
193 : 1 | Fbox(col + 2,line + 2,end_col - 2,end_lin - 2,boxf,G-1BACK-0H,box_knd);
194 : 1 | textf := yellow;
195 : 1 | check_color(textf,G-1BACK-0H);
196 : 1 | Writebetween(col,end_col,line + (end_lin - line) G-1DIV-0H 2 - 1,textf,G-1BACK-0H,'CHECK THE PRINTER FOR PAPER');
197 : 1 | message := 'THE PRINTER IS READY, HIT RETURN TO START';
198 : 1 |
199 : 1 | Offcursor;
200 : 1 | G-1WITH-0H regs G-1DO-0H
201 : 2 | G-1BEGIN-0H
202 : 2 | | ah := 2;
203 : 2 | | dx := 0;
204 : 2 | | G-1INTR-0H($17,regs);
205 : 2 | | printer_on := (ah = 144);
206 : 1 | G-1END-0H;
207 : 2 | G-1REPEAT-0H
208 : 2 | | G-1IF-0H (regs.ah <> 144) G-1THEN-0H
209 : 2 | | message := 'PRINTER OFF LINE, ESC TO ABORT OR RETURN TO CONTINUE';
210 : 2 | | beepr;
211 : 2 | | Writebetween(col,end_col,line + (end_lin - line) G-1DIV-0H 2 + 1,textf,G-1BACK-0H, message);
212 : 2 | | answr := getkey;
213 : 2 | | G-1WITH-0H regs G-1DO-0H
214 : 3 | | G-1BEGIN-0H
215 : 3 | | | ah := 2;
216 : 3 | | | dx := 0;
217 : 3 | | | G-1INTR-0H($17,regs);
218 : 3 | | | printer_on := (ah = 144);
219 : 2 | | G-1END-0H;
220 : 1 | G-1UNTIL-0H ((regs.ah = 144) G-1OR-0H (answr = #27));
221 : 1 | G-1IF-0H (answr = #27) G-1THEN-0H
222 : 1 | Printer_on := G-1FALSE-0H;
223 : 1 | restorescreen(1);
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 5
Line : D Statement
224 : 1 | disposescreen(1);
225 : 0 G-1END-0H; {Function Printer_on_line}
226 : 0
227 : 0
228 : 0
229 : 0
230 : 0
231 : 0
232 : 0
233 : 0 G-1FUNCTION-0H IO_NOT_OK(num : word) : G-1BOOLEAN-0H;
234 : 0
235 : 0 {This is an error manager that will enable you to escape most runtime
236 : 0 errors. In some cases you will add recovery code after this routine
237 : 0 to your program}
238 : 0
239 : 0 G-1VAR-0H
240 : 0 msg,Drive_a,
241 : 0 Drive_b : G-1STRING-0H;
242 : 0
243 : 1 G-1BEGIN-0H
244 : 1 | Drive_a := 'A:';
245 : 1 | Drive_b := 'B:';
246 : 1 | Flushkeybuffer;
247 : 1 | msg := '';
248 : 1 | IO_Not_ok := (num <> 0);
249 : 1 | G-1IF-0H (num <> 0) G-1THEN-0H
250 : 2 | G-1BEGIN-0H
251 : 3 | | G-1CASE-0H num G-1OF-0H
252 : 3 | | | 002 : msg := 'File not found';
253 : 3 | | | 003 : msg := 'Path not found';
254 : 3 | | | 004 : msg := 'Too many open files, Check Files = in config.sys';
255 : 3 | | | 005 : msg := 'File access denied or Drive/Directory exists';
256 : 3 | | | 006 : msg := 'Invalid file handle';
257 : 3 | | | 012 : msg := 'Invalid file access code';
258 : 3 | | | 015 : msg := 'Invalid drive number';
259 : 3 | | | 016 : msg := 'Cannot remove current directory';
260 : 3 | | | 017 : msg := 'Cannot rename across drives';
261 : 3 | | | 100 : msg := 'Disk read error, is file open ?';
262 : 3 | | | 101 : msg := 'Disk write error, is disk full ?';
263 : 3 | | | 102 : msg := 'File not assigned, File name not assigned?';
264 : 3 | | | 103 : msg := 'File not open';
265 : 3 | | | 104 : msg := 'File not open for input';
266 : 3 | | | 105 : msg := 'File not open for output';
267 : 3 | | | 106 : msg := 'Invalid numeric format';
268 : 3 | | | 150 : msg := 'Disk is write-protected, Remove tab?';
269 : 3 | | | 151 : msg := 'Unknown unit';
270 : 3 | | | 152 : msg := 'Drive not ready, close drive door, Thank you';
271 : 3 | | | 153 : msg := 'Unknown command';
272 : 3 | | | 154 : msg := 'CRC error in data';
273 : 3 | | | 155 : msg := 'Bad drive request structure length';
274 : 3 | | | 156 : msg := 'Disk seek error';
275 : 3 | | | {I use error 157 to sense an unformatted floppy.}
276 : 3 | | | 157 : msg := 'Unknown media type. We will format Floppy.';
277 : 3 | | | 158 : msg := 'Sector not found';
278 : 3 | | | 159 : msg := 'Printer out of paper, so put some in';
279 : 3 | | | 160 : msg := 'Device write fault. Usually printer is off';
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 6
Line : D Statement
280 : 3 | | | 161 : msg := 'Device read fault';
281 : 3 | | | 162 : msg := 'Hardware failure';
282 : 3 | | | 200 : msg := 'Division by zero';
283 : 3 | | | 201 : msg := 'Range check error';
284 : 3 | | | 202 : msg := 'Stack overflow';
285 : 3 | | | 203 : msg := 'Insufficient memory';
286 : 3 | | | 204 : msg := 'Invalid pointer operation';
287 : 3 | | | 205 : msg := 'Floating point overflow, number too big';
288 : 3 | | | 206 : msg := 'Floating point underflow';
289 : 3 | | | 207 : msg := 'Invalid floating point operation';
290 : 3 | | | 208 : msg := 'Overlay manager not installed';
291 : 3 | | | 209 : msg := 'Overlay file read error';
292 : 3 | | | G-1ELSE-0H
293 : 3 | | | msg := 'Turbo runtime error '+ NumToStr(num);
294 : 2 | | G-1END-0H;
295 : 2 | | savescreen(5);
296 : 2 | | {These colors are for ega/vga, monochrome is not supported
297 : 2 | | Here is a hint for good window/message formatting.
298 : 2 | | Choose an odd number of lines for the window and
299 : 2 | | an odd number of messages to display
300 : 2 | | or an even number of lines for the window and
301 : 2 | | an even number of messages to display.
302 : 2 | | Display your message centered in the window or box and the
303 : 2 | | screen will look superb. Makes happy satisfied users}
304 : 2 | |
305 : 2 | | Mkwin(10,8,70,17,yellow, lightgray,4);
306 : 2 | | Writebetween(11,69,13,black,lightgray,upper(msg));
307 : 2 | | Writebetween(11,69,14,black,lightgray,'HIT RETURN TO CONTINUE');
308 : 2 | | G-1READLN-0H;
309 : 2 | | restorescreen(5);
310 : 2 | | disposescreen(5);
311 : 2 | | G-1IF-0H ((num = 157) G-1OR-0H (num = 3)) G-1THEN-0H
312 : 3 | | G-1BEGIN-0H
313 : 3 | | | G-1CLRSCR-0H;
314 : 3 | | | SwapVectors;
315 : 3 | | | Exec(GetEnv('COMSPEC'), '/C Format ' + Drive_a);
316 : 3 | | | SwapVectors;
317 : 3 | | | G-1IF-0H DosError <> 0 G-1THEN-0H
318 : 4 | | | G-1BEGIN-0H
319 : 4 | | | | Writebetween(11,69,13,black,lightgray,upper('Could not execute COMMAND.COM'));
320 : 4 | | | | G-1READLN-0H;
321 : 3 | | | G-1END-0H
322 : 3 | | | G-1ELSE-0H
323 : 4 | | | G-1BEGIN-0H
324 : 4 | | | | Writebetween(11,69,13,black,lightgray,upper('Disk ' + Drive_a + ' is Formatted'));
325 : 4 | | | | G-1READLN-0H;
326 : 3 | | | G-1END-0H;
327 : 2 | | G-1END-0H;
328 : 1 | G-1END-0H;
329 : 0 G-1END-0H;
330 : 0
331 : 0
332 : 0 (**************************************************************************)
333 : 0 (* *)
334 : 0 (* *)
335 : 0 (* Mesa Software *)
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 7
Line : D Statement
336 : 0 (* 3302 Fourth Ave, Suite 101 *)
337 : 0 (* San Diego, Ca. 92103 *)
338 : 0 (* *)
339 : 0 (* *)
340 : 0 (* Procedure : Banner File Name : Printr2.pas *)
341 : 0 (* *)
342 : 0 (* Release : Version 1.0 Date : Dec 15, 1989 *)
343 : 0 (* *)
344 : 0 (* *)
345 : 0 (* *)
346 : 0 (**************************************************************************)
347 : 0
348 : 0
349 : 0 G-1PROCEDURE-0H banner(co_nam,addrs,city,st,zip,phone,rpt_title : G-1STRING-0H);
350 : 0
351 : 0 (* this is a procedure with the following call:
352 : 0 banner(co_nam,addrs,City,st,zip,rpt_title);
353 : 0
354 : 0 co_nam := 'MESA SOFTWARE';
355 : 0 addrs := '3302 FOURTH AVENUE, SUITE 101';
356 : 0 city := 'SAN DIEGO'; {If necessary,A routine will add the comma}
357 : 0 st := 'CALIFORNIA';
358 : 0 zip := '92103';
359 : 0 phone := '1(555)555-5555';
360 : 0 rpt_title := 'ACCOUNTS RECEIVABLE AGING REPORT';
361 : 0 dte := Date; this date routine is in Technojocks.miscttt unit.
362 : 0
363 : 0 We have Tested it using a Panasonic 1592. The routine is flexible enough to
364 : 0 take most any size strings within reason. Watch the report titles as they
365 : 0 are expanded, centered and added to. Check the code for comma addition.
366 : 0
367 : 0 *)
368 : 0
369 : 0 G-1VAR-0H
370 : 0 i,j,k,pag_lnth,
371 : 0 lin_lnth,lin_counter,char_count,
372 : 0 Top_headr,bottom_headr,title_lines : G-1INTEGER-0H;
373 : 0 page : G-1STRING-0H;
374 : 0
375 : 0
376 : 0
377 : 0 G-1PROCEDURE-0H Banner_Top;
378 : 0
379 : 0 G-1VAR-0H
380 : 0 countr,i : G-1INTEGER-0H;
381 : 0
382 : 1 G-1BEGIN-0H
383 : 1 | G-1FOR-0H countr := 1 G-1TO-0H top_headr G-1DO-0H
384 : 2 | G-1BEGIN-0H
385 : 2 | | G-1FOR-0H i := 1 G-1TO-0H lin_lnth G-1DO-0H
386 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte);
387 : 2 | | G-1WRITELN-0H(G-1LST-0H);
388 : 2 | | char_count := 0;
389 : 2 | | inc(lin_counter);
390 : 1 | G-1END-0H;
391 : 0 G-1END-0H;
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 8
Line : D Statement
392 : 0
393 : 0 G-1PROCEDURE-0H Banner_Bottom;
394 : 0
395 : 0 G-1VAR-0H
396 : 0 countr,i : G-1INTEGER-0H;
397 : 0
398 : 1 G-1BEGIN-0H
399 : 1 | G-1FOR-0H countr := 1 G-1TO-0H bottom_headr G-1DO-0H
400 : 2 | G-1BEGIN-0H
401 : 2 | | G-1FOR-0H i := 1 G-1TO-0H lin_lnth - 1 G-1DO-0H
402 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte);
403 : 2 | | G-1WRITELN-0H(G-1LST-0H,char_byte);
404 : 1 | G-1END-0H;
405 : 1 | G-1FOR-0H countr := 1 G-1TO-0H 5 G-1DO-0H
406 : 1 | G-1WRITELN-0H(G-1LST-0H);
407 : 1 | {After this routine, the form length, etc, should be set
408 : 1 | for your report paging to follow}
409 : 0 G-1END-0H;
410 : 0
411 : 0
412 : 0 G-1PROCEDURE-0H Banner_left;
413 : 0
414 : 1 G-1BEGIN-0H
415 : 1 |
416 : 1 | {You can use most any replicating code to write the
417 : 1 | following. The sample below will give you an option for most
418 : 1 | of banner routines. You probably know the argument. My code is
419 : 1 | perfect, yours is not so perfect. So Help Yourself.
420 : 1 | You must be careful with the TJocks.Fastttt5.Replicate Function.
421 : 1 | There is a LIMIT of 80 characters. The function is primarily for
422 : 1 | screen writes, so be careful in using it for printer lengths over
423 : 1 | 80 characters, it returns a value of 1.}
424 : 1 |
425 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #0);
426 : 1 | G-1WRITE-0H(G-1LST-0H,replicate(10,char_byte));
427 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0);
428 : 0 G-1END-0H;
429 : 0
430 : 0 G-1PROCEDURE-0H Banner_right;
431 : 0
432 : 1 G-1BEGIN-0H
433 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #2);
434 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'Q' + #132);
435 : 1 | G-1WRITELN-0H(G-1LST-0H,replicate(10,char_byte));
436 : 0 G-1END-0H;
437 : 0
438 : 0 G-1PROCEDURE-0H Filler_Line;
439 : 0
440 : 1 G-1BEGIN-0H
441 : 1 | Banner_Left;
442 : 1 | Banner_Right;
443 : 0 G-1END-0H;
444 : 0
445 : 0
446 : 0 G-1PROCEDURE-0H Filler(num : G-1INTEGER-0H);
447 : 0
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 9
Line : D Statement
448 : 0 G-1VAR-0H
449 : 0 countr : G-1INTEGER-0H;
450 : 0
451 : 1 G-1BEGIN-0H
452 : 1 | G-1FOR-0H countr := 1 G-1TO-0H num G-1DO-0H
453 : 2 | G-1BEGIN-0H
454 : 2 | | Filler_Line;
455 : 1 | G-1END-0H;
456 : 0 G-1END-0H;
457 : 0
458 : 0 G-1PROCEDURE-0H Names;
459 : 0
460 : 1 G-1BEGIN-0H
461 : 1 | G-1IF-0H G-1COPY-0H(city,G-1LENGTH-0H(city),1) <> ',' G-1THEN-0H {We add a comma if necessary}
462 : 1 | city := city + ', ' + st + ' ' + zip
463 : 1 | G-1ELSE-0H
464 : 1 | city := city + ' ' + st + ' ' + zip;
465 : 0 G-1END-0H;
466 : 0
467 : 0 G-1PROCEDURE-0H Report_Title(str1 : G-1STRING-0H);
468 : 0
469 : 1 G-1BEGIN-0H
470 : 1 | banner_left;
471 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #1); {Auto Centering}
472 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '!' + #48); {Double width/double strike printing}
473 : 1 | G-1WRITE-0H(G-1LST-0H,str1);
474 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'W' + #0);
475 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'H');
476 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '!' + #0);
477 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0);
478 : 1 | banner_right;
479 : 0 G-1END-0H;
480 : 0
481 : 0
482 : 0 G-1PROCEDURE-0H Title(sub_title : G-1STRING-0H);
483 : 0
484 : 1 G-1BEGIN-0H
485 : 1 | Banner_left;
486 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #1);
487 : 1 | G-1WRITE-0H(G-1LST-0H,upper(sub_title));
488 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0);
489 : 1 | Banner_Right;
490 : 0 G-1END-0H;
491 : 0
492 : 1 G-1BEGIN-0H
493 : 1 | G-1WRITE-0H(G-1LST-0H,#27,'@'); {Initializes the printer}
494 : 1 | G-1WRITE-0H(G-1LST-0H,#27+'C'+#62); {Sets the page length to 62 lines}
495 : 1 | top_headr := 6; {This is the top lines to fill}
496 : 1 | pag_lnth := 60; {This is the page length 50..66}
497 : 1 | Bottom_headr := 6; {Same as top_headr}
498 : 1 | lin_lnth := 132; {This was written using wide carriage. Try 80}
499 : 1 | lin_counter := 1;
500 : 1 | title_lines := 5; {We need this to calculate top and bottom filler space}
501 : 1 | char_count := 0;
502 : 1 | Names;
503 : 1 | banner_top;
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 10
Line : D Statement
504 : 1 | num := ((pag_lnth - 20) G-1DIV-0H 2 - 1);
505 : 1 | Filler(num);
506 : 1 | rpt_title := upper(rpt_title);
507 : 1 | report_title(rpt_title);
508 : 1 | num := 2;
509 : 1 | Filler(num);
510 : 1 | title(date);
511 : 1 | num := 11;
512 : 1 | Filler(num);
513 : 1 | title(co_nam);
514 : 1 | title(addrs);
515 : 1 | title(city);
516 : 1 | title(phone);
517 : 1 | num := 12;
518 : 1 | Filler(num);
519 : 1 | Banner_bottom;
520 : 0 G-1END-0H;
521 : 0
522 : 0
523 : 0 (***************************************************************************)
524 : 0 (* *)
525 : 0 (* Mesa Software *)
526 : 0 (* 3302 Fourth Ave, Suite 101 *)
527 : 0 (* San Diego, Ca. 92103 *)
528 : 0 (* *)
529 : 0 (* *)
530 : 0 (* Procedure : Report-hdr; File Name : PRINTR2.PAS *)
531 : 0 (* *)
532 : 0 (* Release : Version 1.0 Date : Dec 15,1989 *)
533 : 0 (* *)
534 : 0 (* *)
535 : 0 (* *)
536 : 0 (***************************************************************************)
537 : 0
538 : 0 G-1PROCEDURE-0H Report_hdr(Rpt_Title,co_nam,addrs,city,st,zip,page : G-1STRING-0H);
539 : 0
540 : 0
541 : 0
542 : 0 (* This is a procedure with the following call:
543 : 0 Report_Hdr(Rpt_Title,co_nam,addrs,City,st,zip,rpt_title,page);
544 : 0
545 : 0 co_nam := 'MESA SOFTWARE';
546 : 0 addrs := '3302 FOURTH AVENUE, SUITE 101';
547 : 0 city := 'SAN DIEGO';
548 : 0 st := 'CALIFORNIA';
549 : 0 zip := '92103';
550 : 0 phone := '1(555)555-5555';
551 : 0 dte := Date; this date routine is in Technojocks, sub your own
552 : 0 Rpt_Title := 'ACCOUNTS RECEIVABLE AGING REPORT';
553 : 0
554 : 0 The code here is different from Banner. Choose your own style.
555 : 0 *)
556 : 0 G-1VAR-0H
557 : 0 i,j,k,lnth,pag_num : G-1INTEGER-0H;
558 : 0 pag : G-1STRING-0H;
559 : 0
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 11
Line : D Statement
560 : 0
561 : 0 G-1PROCEDURE-0H Title(rpt_title : G-1STRING-0H);
562 : 0
563 : 0 G-1VAR-0H i : G-1INTEGER-0H;
564 : 1 G-1BEGIN-0H
565 : 1 | G-1FOR-0H i := 1 G-1TO-0H (lnth G-1DIV-0H 2) G-1DO-0H G-1WRITE-0H(G-1LST-0H,' ');
566 : 1 | j := i;
567 : 1 | G-1WRITE-0H(G-1LST-0H,expanded);
568 : 1 | G-1WRITE-0H(G-1LST-0H,Emphaszd);
569 : 1 | i := G-1LENGTH-0H(rpt_title);
570 : 1 | G-1IF-0H G-1ODD-0H(i) G-1THEN-0H rpt_title := rpt_title + ' ';
571 : 1 | G-1FOR-0H i:= 1 G-1TO-0H G-1LENGTH-0H(rpt_title) G-1DIV-0H 2 G-1DO-0H
572 : 1 | G-1WRITE-0H(G-1LST-0H,#8);
573 : 1 | G-1WRITE-0H(G-1LST-0H,rpt_title);
574 : 1 | G-1WRITE-0H(G-1LST-0H,unexpand);
575 : 1 | j := i + G-1LENGTH-0H(rpt_title) G-1DIV-0H 2;
576 : 1 | j := j + (lnth G-1DIV-0H 2);
577 : 0 G-1END-0H;
578 : 0
579 : 0
580 : 0 G-1PROCEDURE-0H Wrt_Address;
581 : 0
582 : 0 G-1VAR-0H
583 : 0 k : G-1INTEGER-0H;
584 : 0
585 : 1 G-1BEGIN-0H
586 : 1 | addrs := '';
587 : 1 | addrs := co_nam + ' ' + addrs + ' ' + city + ' ' + st + ' ' + zip;
588 : 1 | G-1IF-0H G-1ODD-0H(G-1LENGTH-0H(addrs)) G-1THEN-0H addrs := addrs + ' ';
589 : 1 | G-1FOR-0H k := 1 G-1TO-0H lnth G-1DIV-0H 2 - (G-1LENGTH-0H(addrs) G-1DIV-0H 2) G-1DO-0H
590 : 1 | G-1WRITE-0H(G-1LST-0H,#32);
591 : 1 | G-1WRITE-0H(G-1LST-0H,Emphaszd,addrs);
592 : 1 | j := lnth G-1DIV-0H 2 + G-1LENGTH-0H(addrs) G-1DIV-0H 2;
593 : 0 G-1END-0H;
594 : 0
595 : 0 G-1PROCEDURE-0H Wrt_Date;
596 : 0 G-1VAR-0H
597 : 0 i : G-1INTEGER-0H;
598 : 1 G-1BEGIN-0H
599 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth - (j + G-1LENGTH-0H(date) - 1) G-1DO-0H
600 : 1 | G-1WRITE-0H(G-1LST-0H,#32);
601 : 1 | G-1WRITELN-0H(G-1LST-0H,date);
602 : 0 G-1END-0H;
603 : 0
604 : 0 G-1PROCEDURE-0H Wrt_city;
605 : 0 G-1VAR-0H
606 : 0 i : G-1INTEGER-0H;
607 : 1 G-1BEGIN-0H
608 : 1 | city := city + ' ' + st + ' ' + zip;
609 : 1 | k := G-1LENGTH-0H(city);
610 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth G-1DIV-0H 2 - (k G-1DIV-0H 2) G-1DO-0H
611 : 1 | G-1WRITE-0H(G-1LST-0H,#32);
612 : 1 | G-1WRITE-0H(G-1LST-0H,city);
613 : 1 | j := lnth G-1DIV-0H 2 + (G-1LENGTH-0H(city) G-1DIV-0H 2);
614 : 0 G-1END-0H;
615 : 0
D-Xref 6.3
12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 12
Line : D Statement
616 : 0 G-1PROCEDURE-0H Wrt_page;
617 : 0 G-1VAR-0H
618 : 0 i : G-1INTEGER-0H;
619 : 1 G-1BEGIN-0H
620 : 1 | inc(pag_num);
621 : 1 | G-1STR-0H(pag_num,pag);
622 : 1 | page := page + pag;
623 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth - (j + G-1LENGTH-0H(page)) G-1DO-0H
624 : 1 | G-1WRITE-0H(G-1LST-0H,#32);
625 : 1 | G-1WRITELN-0H(G-1LST-0H,page);
626 : 1 | j := 0;
627 : 0 G-1END-0H;
628 : 0
629 : 1 G-1BEGIN-0H
630 : 1 | page := 'Page No. ';
631 : 1 | pag_num := 0;
632 : 1 | lnth := 132;
633 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '@');
634 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'P');
635 : 1 | Title(rpt_title);
636 : 1 | wrt_page;
637 : 1 | Wrt_address;
638 : 1 | Wrt_Date;
639 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth G-1DO-0H
640 : 2 | G-1BEGIN-0H
641 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte);
642 : 2 | | G-1IF-0H (i = lnth G-1DIV-0H 2) G-1THEN-0H G-1WRITE-0H(G-1LST-0H,'!');
643 : 1 | G-1END-0H;
644 : 1 | G-1FOR-0H i := 1 G-1TO-0H 2 G-1DO-0H G-1WRITELN-0H(G-1LST-0H);
645 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '<'); {Home the print head}
646 : 0 G-1END-0H;
647 : 0
648 : 1 G-1BEGIN-0H
649 : 1 | G-1ASSIGN-0H(G-1LST-0H,'LPT1');
650 : 1 | G-1REWRITE-0H(G-1LST-0H);
651 : 0 G-1END-0H.
D-Xref 6.3
12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 13
Cross Reference Page 1
A 114
ADDRS 77 78 349 514 538 586 587 587 588 588 588 589 591 592
AH 114 202 205 208 215 218 220
ANSWR 169 174 212 220 221
AUTHOR 65
B800 97
BACKSPACE 59
BACKSPC 52
BANNER 77 349
BANNER_BOTTOM 393 519
BANNER_LEFT 412 441 470 485
BANNER_RIGHT 430 442 478 489
BANNER_TOP 377 503
BASEOFSCREEN 97
BEEPR 76 140 210
BLACK 191 306 307 319 324
BOTTOM_HEADR 372 399 497
BOXF 171 183 185 186 187 189 190 192 193
BOX_KND 167 180 186 190 193
CARIG_RTN 64
CENTERED 60
CHAR_BYTE 53 386 402 403 426 435 641
CHAR_COUNT 371 388 501
CHECK_COLOR 82 91 185 189 192 195
CITY 77 78 349 461 461 462 462 464 464 515 538 587 608 608 609 612 613
COL 166 176 186 190 193 196 211
COMPRSD 34
COUNTR 148 151 380 383 396 399 405 449 452
CO_NAM 77 78 349 513 538 587
CRT 24
CX 118
DATE 510 599 601
DATESTR 68 80 104
DBL_PRTNG 38
DBL_WID 41
DH 119
DISPOSESCREEN 224 310
DL 120
DOS 24
DOSERROR 317
DRIVE_A 240 244 315 324
DRIVE_B 241 245
DX 203 216
EMPHASZD 36 568 591
END_COL 167 178 186 190 193 196 211
END_LIN 166 179 186 190 193 196 211
ESC 27 29 30 31 32 33 34 35 36 37 38 39 41 42 46 47 50 51
EXEC 315
EXPANDED 46 567
FASTTTT5 24
FBOX 186 190 193
FILLER 446 505 509 512 518
FILLER_LINE 438 454
FLUSHKEYBUFFER 246
FORM_FEED 63
GETENV 315
D-Xref 6.3
12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 14
Cross Reference Page 2
GETKEY 212
GETSYSTEMDATE 80 104 124
I 370 380 385 396 401 557 563 565 566 569 570 571 575 597 599 606 610 618 623 639 642 644
IMPLEMENTATION 86
INC 389 620
INTERFACE 18
IO_NOT_OK 79 233 248
ITRATION 146 151
J 370 557 566 575 576 576 592 599 613 623 626
K 370 557 583 589 609 610
KEYTTT5 24
LEFT_MARGIN 61
LIGHTGRAY 184 305 306 307 319 324
LINE 166 177 186 190 193 196 196 211 211
LINE_FEED 62
LIN_COUNTER 371 389 499
LIN_LNTH 371 385 401 498
LNTH 557 565 576 589 592 599 610 613 623 632 639 642
LONGINT 81 128
MESSAGE 170 197 209 211
MISCTTT5 24
MKWIN 305
MSG 240 247 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271
270 271 272 273 274 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 293
291 293 306
NAMES 458 502
NLQ 29
NLQ_OFF 30
NUM 73 79 233 248 249 251 293 311 311 446 452 504 505 508 509 511 512 517 518
NUMBER 81 128 135
NUMSTR 133 135 136
NUMTOSTR 81 128 136 293
OFF 28 42 47 51 61
OFFCURSOR 199
PAG 558 621 622
PAGE 72 78 373 538 622 622 623 625 630
PAG_LNTH 370 496 504
PAG_NUM 557 620 621 631
PHONE 77 349 516
PRINTER_ON 75 161 181 205 218 222
PRINTR2 17
RED 188
REGISTERS 109 168
REGS 109 113 113 114 115 116 168 200 204 208 213 217 220
REPLICATE 426 435
REPORT_HDR 78 538
REPORT_TITLE 467 507
RESTORESCREEN 223 309
RPT_TITLE 77 78 349 506 506 507 538 561 569 570 570 571 573 575 635
SAVESCREEN 182 295
SCRP_OFF 33
ST 77 78 349 462 464 538 587 608
ST2 110 118 124
ST3 110 119 122 122 122 124
ST4 110 120 123 123 123 124
STR1 467 473
D-Xref 6.3
12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 15
Cross Reference Page 3
STRNTTT5 24
SUBSCRPT 32
SUB_TITLE 482 487
SUPERCRPT 31
SWAPVECTORS 314 316
TEXTF 82 91 99 171 194 195 196 211
THIRTEEN 58
TITLE 482 510 513 514 515 516 561 635
TITLE_LINES 372 500
TOP_HEADR 372 383 495
UNCOMPRSD 35
UNDR_LIN 50
UNDR_LIN_OFF 51
UNEMPHSZD 37
UNEXPAND 47 574
UNIT 17
UN_DBL 39
UN_WID 42
UPPER 306 319 324 487 506
USES 24
WHITE 183
WINTTT5 24
WORD 79 233
WRITEBETWEEN 196 211 306 307 319 324
WRT_ADDRESS 580 637
WRT_CITY 604
WRT_DATE 595 638
WRT_PAGE 616 636
YELLOW 187 194 305
ZIP 77 78 349 462 464 538 587 608
D-Xref 6.3
12-21-1989 at 10 : 04 - - Functions and Procedures for : c:\turbo-5\bulletin\printr2.pas Page 16
Cross Reference Page 4
Alphabetic Sort of Functions
Begin Line End Line Function Name Listing File
80 ForWd GetSystemDate c:\turbo-5\bulletin\printr2.pas
104 125 GetSystemDate c:\turbo-5\bulletin\printr2.pas
233 329 IO_NOT_OK c:\turbo-5\bulletin\printr2.pas
79 ForWd IO_Not_OK c:\turbo-5\bulletin\printr2.pas
128 137 NumToStr c:\turbo-5\bulletin\printr2.pas
81 ForWd NumToStr c:\turbo-5\bulletin\printr2.pas
161 225 Printer_on c:\turbo-5\bulletin\printr2.pas
75 ForWd Printer_on c:\turbo-5\bulletin\printr2.pas
Alphabetic Sort of Procedures
Begin Line End Line Procedure Name Listing File
77 ForWd Banner c:\turbo-5\bulletin\printr2.pas
349 520 Banner c:\turbo-5\bulletin\printr2.pas
393 409 Banner_Bottom c:\turbo-5\bulletin\printr2.pas
377 391 Banner_Top c:\turbo-5\bulletin\printr2.pas
412 428 Banner_left c:\turbo-5\bulletin\printr2.pas
430 436 Banner_right c:\turbo-5\bulletin\printr2.pas
140 159 Beepr c:\turbo-5\bulletin\printr2.pas
76 ForWd Beepr c:\turbo-5\bulletin\printr2.pas
82 651 Check_color c:\turbo-5\bulletin\printr2.pas
91 102 Check_color c:\turbo-5\bulletin\printr2.pas
446 456 Filler c:\turbo-5\bulletin\printr2.pas
438 443 Filler_Line c:\turbo-5\bulletin\printr2.pas
458 465 Names c:\turbo-5\bulletin\printr2.pas
467 479 Report_Title c:\turbo-5\bulletin\printr2.pas
78 ForWd Report_hdr c:\turbo-5\bulletin\printr2.pas
538 646 Report_hdr c:\turbo-5\bulletin\printr2.pas
482 490 Title c:\turbo-5\bulletin\printr2.pas
561 577 Title c:\turbo-5\bulletin\printr2.pas
580 593 Wrt_Address c:\turbo-5\bulletin\printr2.pas
595 602 Wrt_Date c:\turbo-5\bulletin\printr2.pas
604 614 Wrt_city c:\turbo-5\bulletin\printr2.pas
616 627 Wrt_page c:\turbo-5\bulletin\printr2.pas
Number Include Files : 0
Total Number Functions : 8
Total Number Procedures : 22
Total Different Variables : 140
Total Variables Used : 552
Total Lines Processed : 652
